COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00005 00003	! saves on a file any tty input. The file can be managed only by AL_CLOSE
C00008 00004	! input/output:      altf,altrans,alframe,aldec,al_subtree,alid
C00014 00005	! i/o: readexec,readcode,writecode,alfile,close,al_close
C00022 ENDMK
C⊗;
ENTRY;
BEGIN "INPOUT"

DEFINE $INPOUT=TRUE;

REQUIRE "HEADER.SAI" SOURCE_FILE;

STRING  ARRAY $NAMEFL[1:10] ;  			! symbol table of files used;
INTEGER ARRAY $CHNFL[1:10,0:1];			! open/closed and ch #;
INTEGER $ALCH;					! $ALCH=channel used for output;
INTEGER $INPCH;					! channel # for input;
INTEGER ALEOF;
INTEGER TTYEOF;

EXTERNAL INTEGER PROCEDURE UGETF(INTEGER CHAN);
EXTERNAL INTEGER PROCEDURE UGET(INTEGER CHAN);
! saves on a file any tty input. The file can be managed only by AL_CLOSE;
	! The AL_CLOSE instruction without parameters closes all open files and
	  asks for a new tty save file. Upon exit the file is automatically closed;
INTERNAL PROCEDURE TTYSAVE;
	BEGIN STRING ANSWER;
	$TTYFL←NULL;
	OUTSTR("file for TTY output=");ESC_P;
	CLRBUF; ASKUSER;
	IF $CLNE
	   THEN BEGIN
		ANSWER←NAMEFILE;
		OPEN($TTYCH←GETCHAN,"DSK",0,1,2,1000,0,TTYEOF);
		LOOKUP($TTYCH,ANSWER,TTYEOF);
		TTYEOF←-1;
		ENTER($TTYCH,ANSWER,TTYEOF);
		WHILE TTYEOF
		     DO	BEGIN
			PRINT("enter failed");
			ANSWER←FRCVER(ANSWER);
			LOOKUP($TTYCH,ANSWER,TTYEOF);
			ENTER($TTYCH,ANSWER,TTYEOF);
			END;
		IF ¬ TTYEOF THEN BEGIN UGETF($TTYCH); OUT($TTYCH,FF); END;
		OUT($TTYCH,"{ FILE BEING WRITTEN BY POINTY  "&DAT_STR& " }"&CRLF);
		$OUT←TRUE;
		$TTYFL←ANSWER;
		$OULST←NULL;
		END
	   ELSE $OUT←FALSE;
	END;

	! returns a string with the names of files used for output and their 
	  state (open/closed);
INTERNAL STRING PROCEDURE FILE_STRING;
	BEGIN
	INTEGER I;STRING TS;TS←NULL;
	FOR I←1 STEP 1 UNTIL $TOTFL 
	     DO	BEGIN
		IF EQU($NAMEFL[I],$ALFL) 
		   THEN TS←TS&"*"
		   ELSE TS←TS&" ";
		TS←TS&"OC"[1+$CHNFL[I,0] FOR 1]&":"&$NAMEFL[I]&CRLF;
		END;
	RETURN(TS);
	END;
! input/output:      altf,altrans,alframe,aldec,al_subtree,alid;

	! types on the file (open on $ALCH) the frame declaration and assignment
	  of affixment for the frame pointed by nd. If the frame is affixed 
	  independently an assignment instruction is generated, otherwhise an
	  affix instruction, with the correct type of affixment is produced;

PROCEDURE ALDEC(RPTR(FRAME) ND);       
	BEGIN
	STRING NAME,DS,FS;
 	NAME←FRAME:PNAME[ND];				! frame pname;
	IF SYMBOL:ACCESS[FRAME:SYM[ND]]≠#ARRAY_ELEMENT
		THEN DS←"FRAME "&NAME&";"&CRLF
		ELSE DS←NULL;
 	IF FRAME:HOWLINKED[ND]=#INDLK
	   THEN FS←NAME&" ← "&CVSYM(FRAME:SYM[ND],FILE_D)&";"&DLF
	   ELSE BEGIN
        	FS←"AFFIX "&NAME&" TO "&FRAME:PNAME[FRAME:DAD[ND]]&" AT"
			&CRLF&$BLANK[1 TO 6]&"TRANS"&CVSYM(FRAME:SYM[ND],FILE_D)[6 TO ∞];
		IF FRAME:HOWLINKED[ND]=#NRGLK
		   THEN FS←FS&" NONRIGIDLY;"&DLF
		   ELSE FS←FS&" RIGIDLY;"&DLF;
		END;
	CPRINT($ALCH,DS,FS);
	END;

	! finds the different frames looking at the frame tree;


PROCEDURE MC_OUT(RPTR(SYMBOL) EEE);
	BEGIN 
	STRING MS;
	MS←"DEFINE "&MACRO:HEAD[SYMBOL:OBJECT[EEE]]&" = "&CVSYM(EEE)&";"&DLF;
	CPRINT($ALCH,MS);
	END;

PROCEDURE PR_OUT(RPTR(SYMBOL) EEE);
	BEGIN
	STRING PS;
	! temporary;
	PS←CVSYM(EEE)&DLF;
	CPRINT($ALCH,PS);
	END;

RECURSIVE PROCEDURE FR_OUT(RPTR(FRAME) ND);
	BEGIN
	RPTR(FRAME) SN; STRING S;
	IF NOT(ND=F_WRLD OR EQU(S←FRAME:PNAME[ND],"BPARK")
		OR EQU(S,"YPARK") OR EQU(S,"BARM")OR EQU(S,"YARM")
		OR EQU(S,"BGRASP"))
		THEN ALDEC(ND);
	SN←FRAME:SON[ND];
	WHILE SN≠NULL_RECORD 
	     DO	BEGIN
		FR_OUT(SN);       
	 	SN←FRAME:EBRO[SN];
		END;
	END;

	! types on the file (open on $ALCH) the declarations and
	  assignments;

PRELOAD_WITH "SCALAR ","DISTANCE VECTOR ","ROT ","TRANS ","FRAME ";
STRING ARRAY DTYPES[#SC:#FR];

STRING PROCEDURE EL_OUT(RPTR(SYMBOL)ADDR);
	BEGIN
	STRING DS,VS;
	DS←DTYPES[SYMBOL:TYPE[ADDR]]&" "&SYMBOL:PNAME[ADDR]&";"&CRLF;
	VS←SYMBOL:PNAME[ADDR]&" ← "& CVSYM(ADDR,FILE_D)&";"&DLF;
	RETURN(DS&VS);
	END;

STRING PROCEDURE ARR_OUT(RPTR(SYMBOL)ADDR);
	BEGIN
	RPTR(ARRAYREC) ARRREC;
	STRING DS,VS;
	INTEGER I,#DIM;
	$EVLARR(ADDR);
	DS←DTYPES[SYMBOL:TYPE[ADDR]]&"ARRAY "&SYMBOL:PNAME[ADDR]&"[";
	ARRREC←SYMBOL:OBJECT[ADDR];
	FOR I←1 STEP 1 UNTIL (#DIM←ARRAYREC:#DIM[ARRREC]) DO
		DS←DS&CVS(ARRAYREC:LB[ARRREC][I])&":"
			&CVS(ARRAYREC:UB[ARRREC][I])&",";
	DS←DS[1 TO INF - 1]&"];"&CRLF;
	VS←NULL;
	FOR I←1 STEP 1 UNTIL ARRAYREC:#EL[ARRREC] DO
		VS←VS&SYMBOL:PNAME[ARRAYREC:PTR[ARRREC][I]]&"←"
			&CVSYM(ARRAYREC:PTR[ARRREC][I],FILE_D)
			&";"&CRLF;
	RETURN(DS&VS&CRLF);
	END;

PROCEDURE ST_OUT(INTEGER TYPE);
	BEGIN "U" INTEGER I;
	CASE TYPE OF
	    BEGIN "CASE"
		  [#SC] [#VT][#RT][#TR]
			FOR I←OFFSET[RES_OFFSET,TYPE]+1 STEP 1 UNTIL
				 $ENTRY[TYPE] DO
				IF SYMBOL:ACCESS[$YMTAB[TYPE,I]]=#ARRAY THEN
			      CPRINT($ALCH,ARR_OUT($YMTAB[TYPE,I])) ELSE
			      CPRINT($ALCH,EL_OUT($YMTAB[TYPE,I]));
		  [#FR] FR_OUT(SYMBOL:OBJECT[WORLD]);
		  [#PR] FOR I←OFFSET[RES_OFFSET,TYPE]+1 STEP 1 UNTIL $ENTRY[TYPE] DO
				PR_OUT($YMTAB[TYPE,I]);
		  [#MC] FOR I←OFFSET[RES_OFFSET,TYPE]+1 STEP 1 UNTIL $ENTRY[TYPE] DO
				MC_OUT($YMTAB[TYPE,I])
		END "CASE";
	END "U";
! i/o: readexec,readcode,writecode,alfile,close,al_close;

	! if the file has been previously used returns its number in table,
	  otherwise returns 0;

INTERNAL INTEGER PROCEDURE ISFILE(STRING FILE);
	BEGIN
	INTEGER I;
	FOR I←1 STEP 1 UNTIL $TOTFL DO
	    IF EQU($NAMEFL[I],FILE) THEN RETURN (I);
	RETURN(0);
	END;

SIMPLE  PROCEDURE OPENFL(REFERENCE STRING FILE;INTEGER IND(0));
	BEGIN 
	INTEGER $NOEXIST;
 	OPEN($ALCH←GETCHAN,"DSK",0,1,2,1000,0,ALEOF);
	ALEOF←-1;
	LOOKUP($ALCH,FILE,$NOEXIST);
	ENTER($ALCH,FILE,ALEOF);
	WHILE ALEOF 
	     DO	BEGIN
		PRINT(" enter failed ");
		FILE←FRCVER(FILE);
		ENTER($ALCH,FILE,ALEOF);
		END;
 	IF IND>0 
 	   THEN BEGIN
 		$CHNFL[IND,0]←0;			! file existent closed;
 		$CHNFL[IND,1]←$ALCH;
 		END
 	   ELSE BEGIN
		$TOTFL←$TOTFL+1;			! one new file;
	IF $TOTFL>10 THEN ERROR("Ten AL files open, cant open any more");
		$NAMEFL[$TOTFL]←FILE;			! name;
		$CHNFL[$TOTFL,1]←$ALCH;			! channel number;
	 	$CHNFL[$TOTFL,0]←0;			! file open;
 		END;
	IF ¬$NOEXIST THEN BEGIN UGETF($ALCH); OUT($ALCH,FF); END;
	OUT($ALCH,"{ FILE BEING WRITTEN BY POINTY : "&DAT_STR&" }"&CRLF);
	$OULST←NULL;					! file status modified;
	END;

INTERNAL PROCEDURE FCLOSE;
	BEGIN
	INTEGER IND;
	FOR IND←1 STEP 1 UNTIL $TOTFL DO
	    BEGIN
	    $CHNFL[IND,0]←1;  				! sets the file closed in table;
	    PRINT("CLOSING ",$NAMEFL[IND],CRLF); ESC_P;
	    RELEASE($CHNFL[IND,1]);			! releases channels;
	    $ALFL←"DECLAR.AL";				! new default file;
	    END;
	IF $OUT
	   THEN BEGIN
		PRINT("CLOSING ",$TTYFL,CRLF);ESC_P;
		RELEASE($TTYCH,0);			! closes the tty save file;
		$OUT←FALSE;				! sets the flag;
		END;
	END;

	! close the file open;

INTERNAL PROCEDURE AL_CLOSE(STRING FILE );
	BEGIN
       	INTEGER IND;
 	IND←ISFILE(FILE);				! address of file in table;
	IF IND=0 THEN ERROR(FILE&" is not open");
 	$CHNFL[IND,0]←1;				! closes the file;
 	RELEASE($CHNFL[IND,1]);
	! looks for an open file: if no file is open DECLAR.AL is proposed;
	$ALFL←"DECLAR.AL";			
	FOR IND←$TOTFL STEP -1 UNTIL 1 DO
		IF NOT $CHNFL[IND,0] THEN $ALFL←$NAMEFL[IND];
	$OULST←NULL;					! file status modified;
	END;


INTERNAL PROCEDURE WRITECODE(STRING FILE;RPTR(SYMBOL) ELEMENT);
	BEGIN
	INTEGER IND;
	! checks if file exists and if it's open, otherwise open it;
	IF (IND←ISFILE(FILE))= 0
	   THEN	OPENFL(FILE)
	   ELSE IF $CHNFL[IND,0]
		   THEN OPENFL(FILE,IND)
		   ELSE $ALCH←$CHNFL[IND,1];		! channel number;
	! updates information for display;
	IF NOT EQU(FILE,$ALFL)
	   THEN BEGIN
		$ALFL←FILE;				! last file used 
		$OULST←NULL;	
		END;
	! output on the file;

	IF ELEMENT=NULL_RECORD
	THEN BEGIN INTEGER I;
		FOR I←#SC,#VT,#RT,#TR,#FR,#MC DO ST_OUT(I);
	     END
	ELSE IF SYMBOL:ACCESS[ELEMENT]=#ARRAY THEN
	     CPRINT($ALCH,ARR_OUT(ELEMENT))
	ELSE CASE SYMBOL:TYPE[ELEMENT] OF
	     BEGIN
		[#SC][#VT][#RT][#TR]
			CPRINT($ALCH,EL_OUT(ELEMENT));
		[#FR] FR_OUT(SYMBOL:OBJECT[ELEMENT]);
		[#MC] MC_OUT(ELEMENT);
		[#PR] OUTSTR("can't output procedures yet")
	     END;
	UDATEFILE($ALCH);
	END;
END "INPOUT";